VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsGetXMLHeader"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Public Function GetXMLHeader(ByVal nReqSeqNum As String, ByVal nTypeResponse As String, _
                             ByRef nReferenceId As String, ByRef nComId As String, _
                             ByRef nBuId As String, ByRef nNewMessageID As String, ByRef sFormType As String, _
                             ByVal strServerName As String) As String

Dim adoConn As ADODB.Connection
Dim RSHeader As ADODB.Recordset
Dim adoComm As ADODB.Command
Dim CommandText As String

ServerName = strServerName

On Error GoTo PROC_ERROR

Set adoConn = New ADODB.Connection
With adoConn
    .CursorLocation = adUseClient
    .ConnectionString = GetConnectionString() 'Johann (20090625): Centralised code for connection string added
    .Open
End With

Set RSHeader = New ADODB.Recordset
With RSHeader
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
End With
   
'Johann(2009/07/23):    If it's a cancellation, get the reference ID for the cancellation request, not the directive request
If nTypeResponse = "04" Then
    CommandText = "Select * from dir_xml_header where req_seq_num = " & nReqSeqNum & " and reference_id in (select reference_id from dir_interface_index where req_seq_num = " & nReqSeqNum & " and keytax_type = '03')"
Else
    CommandText = "Select * from dir_xml_header where req_seq_num = " & nReqSeqNum
End If

'Get Header Data
Set adoComm = New ADODB.Command
With adoComm
    .CommandText = CommandText
    .CommandType = adCmdText
    Set .ActiveConnection = adoConn
End With

'Set RSHeader.DataSource = adoConn
Set RSHeader = adoComm.Execute

nNumHeaderRecords = RSHeader.RecordCount
If nNumHeaderRecords = 0 Then
    sErrorMessage = "There was no Header data to extract"
    nNumHeaderRecords = 0
    Exit Function
Else
    dtDate = RSHeader.Fields("process_date").Value
    dtTime = RSHeader.Fields("process_time").Value
    sName = RSHeader.Fields("requestor_name").Value
    strUser = RSHeader.Fields("requestor_user_id").Value
    sEmailTo = RSHeader.Fields("requestor_email").Value
    nComId = RSHeader.Fields("com_id").Value
    nBuId = RSHeader.Fields("buni_id").Value
    nReferenceId = RSHeader.Fields("reference_id").Value
    
    'Fikile 25-05-2007
    'Check if the form type is null before assigning it
    If Not IsNull(RSHeader.Fields("form_type").Value) Then
        sFormType = RSHeader.Fields("form_type").Value
    End If
End If

' Get Request Status Code
Dim dllRequestStatus As Object
Set dllRequestStatus = CreateObject("KeyTax.clsRequests")

nTypeStatus = dllRequestStatus.GetRequestStatus(nReqSeqNum)

'Write XML File
Dim dllWriteXML As clsWriteXML
Set dllWriteXML = New clsWriteXML

'nTypeResponse - (get from calling dll)02=directive request response,05=decline response,06=load response,09=status response,10=file error response
'nTypeStatus - (get from keytax dll)01/02=Decline,06=InProgress,07=finalised,08=cancelled


GetXMLHeader = dllWriteXML.WriteXML(nReqSeqNum, nTypeResponse, nNewMessageID, nComId, nBuId, nReferenceId)
    
'Clean up
RSHeader.Close
Set RSHeader = Nothing
adoConn.Close
Set adoConn = Nothing
Set adoComm = Nothing
Set dllRequestStatus = Nothing
Set dllWriteXML = Nothing
    
PROC_EXIT:
  Exit Function

PROC_ERROR:
  Err.Raise Err.Number, _
            "clsGetXMLHeader/GetXMLHeader", _
            Err.Description
  Resume PROC_EXIT

End Function


